--# -path=.:prelude:alltenses
concrete SyllogismNor of Syllogism = LexiconSyllNor **
   open CommonScand, StructuralNor, IrregNor, ResNor, DiffNor, Prelude in{
  flags coding=utf8 ;

  param WClass = IsNoun | IsVerb | IsAdj | IsPhrase;
  param PClass = Single | Conjunct | Disjunct;  

 
 lincat Syllogism = {s : Str};
        Sentence  = {s : Str};
        Subject   = {s : Number => Str; g : Gender};
        Property  = {s : Number => Polarity => Gender => Str;
                     c : PClass};
        PropertyPart = {s : Either => Number => Polarity => Gender =>  Str;
                           c : WClass; lock_PropertyPart : {} }; 
        Word = {sub : Number => Str;
                prop : Either => Number => Polarity => Gender => Str;
                g: Gender;c : WClass  };
 
        Conclusion = {s : Str};
        Constant  = {s : Str};
        Sentence  = {s : Str};
        Sentences  = {s : Str};
        Const = {s : Str};
        AllQ  = {s : Str; n : Number}; 
        NoQ   = {s : Number => Gender => Str};

 lin
   AWord a = {sub = (adjToSub a).s;  prop = (adjToProp a).s; g = Utr;
              c = IsAdj};
   NWord n = {sub = (nounToSub n).s; prop = (nounToProp n).s; g = (ngen2gen n.g);
              c = IsNoun};
   VWord v ={sub = (verbToSub v).s;  prop = (verbToProp v).s; g = Utr;
             c = IsVerb};
   CWord c = {s = c.s ! Nom};

   CpP const prop = {s = const.s ++ prop.s ! Sg ! Pos ! Utr };
   CnP const prop = {s = const.s ++ prop.s ! Sg ! Neg ! Utr};
   SaP allq sub prop = {s = allq.s ++ sub.s ! allq.n ++
                             prop.s ! allq.n ! Pos !  sub.g};
   SoP sub prop = {s = some_Det ++ sub.s ! Pl ++ prop.s ! Pl ! Neg ! sub.g};
   SeP noq sub prop = let quant = sepq sub prop noq in
                  {s = quant.s ++ sub.s ! quant.n 
                                 ++ prop.s ! quant.n ! quant.p ! sub.g};
   SiP sub prop = {s = some_Det ++ sub.s ! Pl ++ prop.s ! Pl !Pos ! sub.g};

   ToProperty sWord = mkProp sWord ** {c = Single};  
   ToSubject  sWord = {s = sWord.sub; g = sWord.g};
   ToConstant cWord = cWord;
   ToPropertyPart word = {s = word.prop; c = word.c} 
                                  ** {lock_PropertyPart = <>};  
   ToConclusion sent = sent | {s = "er det sant at" ++ sent.s};

   SPhrase a n = {s = (phrToSub a n).s; g = (ngen2gen n.g)};
   PPhrase a n = {s = (phrToProp a n).s; c = Single};  

   All = {s = "Alle"; n = Pl};
   No = {s = table {Sg => table {Neutr => "Ikke noe";
                                 utr   => "Ingen"};
                     Pl => \\_ =>"Ingen"}};


   mkSyllogism ps c = {s = "(" ++ ps.s ++ ") ->" ++ c.s };

   mkSentences  s1 s2 = {s = s1.s ++ "+" ++ s2.s};
   appSentences s1 ss = {s = s1.s ++ "+" ++ ss.s};
   And p1 p2 = {s = \\num,pol,gen => propAnd p1 p2 num pol gen;
                c = Conjunct} ; 
   Or  p1 p2 = {s = \\num,pol,gen => propOr p1 p2 num pol gen;
                c = Disjunct};  
 


--------OPERATIONS--------------------------------------------------

 {-
   The parameter Either works like a placeholder in a property which tells
   where to insert either/neither/both/not.
   NorS is for the second part of a dis/conjunction and gives the phrase 
   whithout "is" or "does" (eg. "a laptop").
   NoneS is for phrases without any of these words. 
 -}
 param Either  = NotS | NeitherS | EitherS | NorS | NoneS | BothS;
  
 oper
  notStr : Either -> Str =
   \not -> case not of {
     NotS => "ikke";
     NeitherS => "verken";
     EitherS => "enten";
     NorS    => "";
     BothS   => "både";
     NoneS   => ""};  
   


  -- creates a Property from a PropertyPart
  mkProp : PropertyPart -> {s : Number => Polarity => Gender => Str} =
    \w ->
     {s = \\n => table {Neg => \\g => w.s ! NotS ! n ! Neg ! g;
                        _    => \\g => w.s ! NoneS ! n ! Pos ! g}};


  -- given an adjective, returns it in plural form
  adjPl : A -> Str = \wor ->
     wor.s ! AF (APosit (Strong GPl)) Nom; 

  -- given an adjective and a Gender, returns the adjective in singular form
  adjSg : A -> Gender -> Str = \wor, g ->
    wor.s ! (AF (APosit (Strong (GSg g))) Nom);

  -- given a verb, returns the VForm that should be used
  getVerbForm : VType -> VForm =
    \type ->
    case type of {
      VPass => VF (VPres Pass);
      _     => VF (VPres Act)
    };



  -- operations for creating Words out of adjectives, nouns and verbs
  adjToProp : A -> {s : Either => Number => Polarity => Gender => Str}
     =  \wor -> 
       { s  = table {NorS => table {Sg => \\_,g => adjSg wor g ; 
                                    Pl => \\_,_ => adjPl wor};
                     not  => table{
                 Sg => \\_,g => "er" ++ notStr not ++ adjSg wor g ; 
                 Pl => \\_,_ => "er" ++ notStr not ++ adjPl wor   
                      }
        }} ;   

  adjToSub : A -> {s : Number => Str} = \adj -> 
         { s = table{Sg => "som er" ++ adjSg adj Utr; 
                     Pl => "som er" ++ adjPl adj}};
       

  nounToSub : N -> {s : Number => Str } = \wor -> 
     { s = table {Sg => wor.s ! Sg ! Indef ! Nom; 
                     Pl => wor.s ! Pl ! Indef !  Nom } 
     }; 


  nounToProp : N -> { s : Either => Number => Polarity => Gender => Str }
       = \wor -> 
     { s = table{
         NorS => table{
           Sg => \\_,_ => artIndef ! wor.g ++ wor.s ! Sg ! Indef ! Nom;
           Pl => \\_,_ => wor.s ! Pl ! Indef ! Nom};
         not => table {
           Sg => \\_,_ => "er" ++ notStr not 
                         ++ artIndef ! wor.g  ++ (wor.s ! Sg ! Indef! Nom)  ; 
           Pl => \\_,_ => "er" ++ notStr not ++ wor.s ! Pl ! Indef ! Nom
                 }      
     }} ;        

  verbToSub :  V -> {s: Number => Str}
      = \wor -> let vform = getVerbForm wor.vtype in
   { s = table {Sg => "som" ++ wor.s ! VF (VPres Act) ++ wor.part;  
                Pl => "som" ++ wor.s ! VF (VPres Act) ++ wor.part}}; 


  verbToProp : V -> { s : Either => Number => Polarity => Gender => Str} 
     = \wor -> let vform = getVerbForm (wor.vtype) in   
  { s = table{
   NorS => \\_,_,_ => wor.s ! vform ++ wor.part;
   NotS => \\_ => table {Neg => \\_ => wor.s ! vform ++ notStr NotS ++ wor.part; 
                         _    => \\_ => wor.s ! vform ++ wor.part};
   either => \\_,_,_ => wor.s! vform ++ notStr either ++ wor.part}};



  -- operations for creating Words out of phrases like 'en blå blomma'
  phrToSub : A -> N -> {s : Number => Str} =
     \a, n -> 
     {s = table {Sg => adjSg a (ngen2gen n.g) ++ n.s ! Sg ! Indef ! Nom;
                 Pl => adjPl a ++ n.s ! Pl ! Indef !  Nom}};
  
  phrToProp : A -> N -> {s : Number => Polarity=> Gender => Str} =
    \a, n ->
     {s = table {
         Sg => table{ 
             Neg => \\_ =>  "er" ++ notStr NotS ++ artIndef ! n.g ++ adjSg a (ngen2gen n.g)
                                              ++ n.s ! Sg ! Indef ! Nom;
             _    => \\_ => "er" ++ artIndef ! n.g ++ adjSg a (ngen2gen n.g) 
                                        ++ n.s ! Sg ! Indef ! Nom}; 
         Pl => table{
             Neg=> \\_ => "er" ++ notStr NotS ++ adjPl a 
                                                  ++ n.s ! Pl ! Indef ! Nom;
             _   => \\_ => "er" ++ adjPl a ++ n.s ! Pl ! Indef ! Nom}}};

  -- operations for conjuctions 
  propAnd : PropertyPart -> PropertyPart -> Number -> Polarity 
                                                         -> Gender -> Str =
    \word1, word2, num, pol, gen ->
      let begin = (word1.s ! polarityW1 pol ! num ! pol ! gen ++ "og") in
         case sameClass word1.c word2.c of {
           True  => begin ++ word2.s ! polarityW2 pol True ! num ! pol ! gen ;
           False => begin ++ word2.s ! polarityW2 pol False ! num ! pol ! gen
         };

  polarityW1 : Polarity -> Either = 
     \pol -> case pol of{
          Neg => NotS;
          _    => BothS};

  polarityW2 : Polarity -> Bool -> Either = 
     \pol, b -> case pol of{
          Neg => NotS;
          _    => case b of { True =>  NorS; False => NoneS}};

  -- operations for disjuction 
  propOr : PropertyPart -> PropertyPart -> Number -> 
                  Polarity -> Gender -> Str
      = \word1, word2, num, pol, gen ->
     case pol of {
         Pos => combineDisj word1 word2 num Pos gen EitherS;
         _    => combineDisj word1 word2 num Pos gen NeitherS 
      };
 

  combineDisj : PropertyPart -> PropertyPart -> Number ->
          Polarity -> Gender -> Either -> Str
   = \word1, word2, num, pol, gen, not -> 
     let begin = word1.s ! not ! num ! pol ! gen ++ "eller"  in
    case sameClass word1.c word2.c of{
      True => begin ++ word2.s ! NorS ! num ! pol ! gen;
      False => begin ++ word2.s ! NoneS ! num ! pol ! gen
  }; 

-- for seeing how two words can be combined
  sameClass : WClass -> WClass -> Bool =
   \c1, c2 -> case c1 of{
     IsVerb => case c2 of{ IsVerb => True;
                           _       => False};
      _     => case c2 of{ IsVerb => False;
                            _      => True}};

 some_Det : Str =
  "Noen" | "Visse" | "Enkelte";


 sepq : Subject -> Property -> NoQ -> {s : Str; n : Number; p : Polarity} =
   \sub,p,no -> let num = Sg | Pl in
      case p.c of 
          {Disjunct => {s = "Alle"; n = Pl; p = Neg};
           _        => {s = no.s ! num ! sub.g ;  n = num; p = Pos}};


}

